home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / Except / TestYAST32Unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-09-06  |  2.1 KB  |  110 lines
  1. unit TestYAST32Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ShowBtn: TButton;
  12.     Memo1: TMemo;
  13.     RawCheckBox: TCheckBox;
  14.     procedure ShowBtnClick(Sender: TObject);
  15.   private
  16.     procedure Five;
  17.     procedure Four;
  18.   end;
  19.  
  20. var
  21.   Form1: TForm1;
  22.  
  23. implementation
  24.  
  25. {$R *.DFM}
  26.  
  27. uses
  28.   HVYAST32;
  29.  
  30. function StackDumpStr: string;
  31. var
  32.   i: integer;
  33. begin
  34.   Result := 'Stackframe-based trace:'#13#10+'Physical Logical';
  35.   for i := 0 to StackDumpCount-1 do
  36.     with StackDump[i] do
  37.       Result := Format('%s'#13#10'%.8x %.8x',
  38.         [Result, DWORD(CallerAdr), PhysicalToLogical(DWORD(CallerAdr))]);
  39. end;
  40.  
  41. {$W+} { Make sure the compiler generates stack frames for the following routines }
  42.  
  43. procedure One;
  44. var
  45.   Trace: string;
  46. begin
  47.   { Generate a stack trace, skipping no levels
  48.     The stack trace will be saved in the global StackDump array }
  49.   SaveStackTrace(Form1.RawCheckBox.Checked , 0, nil);
  50.   Trace := StackDumpStr;
  51.  
  52.   { Now report the contents of the StackDump array into the memo }
  53.   Form1.Memo1.Lines.Clear;
  54.   Form1.Memo1.Lines.Add(Trace);
  55. end;
  56.  
  57. procedure Two;
  58. begin
  59.   { OOPS! The compiler does not crate a stack-frame
  60.     for all-assembly routines like this one. }
  61.   asm
  62.     { Create a default stack frame manually }
  63.     PUSH EBP
  64.     MOV  EBP, ESP
  65.  
  66.     { Simulate a CALL instruction using PUSH and RET }
  67.     PUSH OFFSET @@ret_addr
  68.     PUSH OFFSET One
  69.     RET
  70.  
  71.     { After the 'call' we get back here }
  72. @@ret_addr:
  73.  
  74.     { Clean up the stack frame }
  75.     POP EBP
  76.   end;
  77. end;
  78.  
  79. procedure Three;
  80. begin
  81.   { Normal procedure call }
  82.   Two;
  83. end;
  84.  
  85. procedure TForm1.Four;
  86. var
  87.   ProcVarCall: procedure;
  88. begin
  89.   { Call through a procedure variable }
  90.   ProcVarCall := Three;
  91.   ProcVarCall;
  92. end;
  93.  
  94. procedure TForm1.Five;
  95. var
  96.   EventCall: procedure of object;
  97. begin
  98.   { Call through an event or method variable }
  99.   EventCall := Four;
  100.   EventCall;
  101. end;
  102.  
  103. procedure TForm1.ShowBtnClick(Sender: TObject);
  104. begin
  105.   { Normal method call }
  106.   Five;
  107. end;
  108.  
  109. end.
  110.